perm filename PROT.SAI[SYS,HE]4 blob sn#052049 filedate 1973-07-03 generic text, type T, neo UTF8
COMMENT ⊗   VALID 00016 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00005 00002	PROT prototype and recognition schemes
 00008 00003	_ EXTERNAL AND FORWARD PROCEDURES
 00010 00004	_ FPROPT, LESSFT
 00013 00005	_ LNFEAT
 00017 00006	_ COFEAT
 00020 00007	_ FINDFT, MAXLCR
 00022 00008	_ FTEX
 00025 00009	_ INSFT
 00030 00010	_ PLEQV
 00032 00011	_ PLEQV cont
 00034 00012	_ PLEQV cont
 00037 00013	_ PLEQV cont
 00039 00014	_ CREPRO
 00042 00015	_ CREPRO cont
 00045 00016	_ CREPRO cont
 00047 ENDMK
⊗;
COMMENT PROT prototype and recognition schemes;

ENTRY MASKLF,MASKCF,LESSFT,LNFEAT,COFEAT,FINDFT,FTEX,FPROPT,INSFT,PLEQV,
	CREPRO;

BEGIN "PROT"

DEFINE CL="'15&'12",
	QS="STRING",
	QESP="EXTERNAL SIMPLE STRING PROCEDURE",
	QI="INTEGER",
	QR="REAL",
	QRI="REFERENCE INTEGER",
	QRR="REFERENCE REAL",
	QEP="EXTERNAL SIMPLE PROCEDURE",
	QEIP="EXTERNAL SIMPLE INTEGER PROCEDURE",
	QERP="EXTERNAL SIMPLE REAL PROCEDURE",
	QFOP="FORWARD INTERNAL SIMPLE PROCEDURE",
	QFOIP="FORWARD INTERNAL SIMPLE INTEGER PROCEDURE",
	QFORP="FORWARD INTERNAL SIMPLE REAL PROCEDURE",
	_="COMMENT",
	LOOP(I,J,K,L)="FOR I←J STEP L UNTIL K DO",
	BELCRE(I)="LVNEXT(I,-1)",
	SAFEX="SAFE";

INTEGER ISV1,ISV2;

EXTERNAL INTEGER NOL,MAXNOL,MAXNOV,LDATE,LNCRE1,LNCRE2,WHERE,PLTOT,
	MODIF,PFTKEY,PFTOT,PCFTOT,DFORCE,MAXPFT,NOLS,EDLIN,FTREV,SCF,
	PFFREE,PLFTOT,NPRO,MXNPRO,MAXPLT,PFREE,MAXPLS,MAXPVS;

INTERNAL INTEGER DEGABL,DEGSW;

EXTERNAL REAL RMAP;

EXTERNAL STRING PREXT;

SAFEX EXTERNAL INTEGER ARRAY DICH[0:1],LEDG1,LFEAT,LVERCO,LVER,
	PLINES,PVERTS,PPTRL,PLINE,PLINE2,PLINEF,PFLST,PFPRO,PFEAT,
	CFEAT,LCREDE[1:1],PFPTR[0:1];

SAFEX EXTERNAL REAL ARRAY SVANG,ANGARG,XLCOR,YLCOR,RLEN[1:1];

SAFEX EXTERNAL STRING ARRAY PNAME[1:1];
_ EXTERNAL AND FORWARD PROCEDURES;


QEIP BITS(QI I,J,K);
QERP AMOD(QR R,S);
QERP ANGLIN(QI I,J);
QEIP NEXTSV(QI I,J);
QEP UPPDAT;
QEIP LINCHA(QI I,J,K);
QEP TELL(QS S);
QEP UNTELL;
QESP QREAD;
QEP LINED;
QEP XREFC(QI I);
QEIP SHARCV(QI I,J);
QEIP LACT(QI I);
QEIP SVDIST(QI I,J);
QEIP LVOPP(QI I);
QEIP KARN(QR X1,Y1,X2,Y2,X3,Y3,X4,Y4; QI IC);
QFOIP FINDFT(QI I);
QEIP LVERPT(QI I);
QEIP NLINCV(QI I);
QEIP ISIGN(QI I,J);
QEIP LVNEXT(QI I,J);
QEIP LFDIF(QI I,J,K,L);
QERP ANGSV(QI A,B);


_ Returns the line-feature word with the following bits zeroed:
  0, 1, 2, 4 iff 3 is on, 5, 7, 12.;

DEFINE MASKLF(LF)="(LF LAND ('767510767510 LOR 
		(((LF LAND '10000010) XOR '10000010) LSH 1)))";


_ Returns the compound feature word with the following bits zeroed:
  2 and 3, iff bit 0 or bit 1 is on.;

DEFINE MASKCF(CF)="(CF LAND ('777763777763 LOR (3*((CF LAND '1000001)
	LOR ((CF LAND '2000002) LSH -1)) LSH 2)))";
_ FPROPT, LESSFT;

_ Returns location of PFPRO-word, containing reference to prototype PROT,
  assuming PFPTR at ADDR. Returns 0 if no reference was found.;

INTERNAL SIMPLE INTEGER PROCEDURE FPROPT(INTEGER ADDR,PROT);
	BEGIN "FPROPT"
	INTEGER ID;
	ID←PFPTR[ADDR] LAND '7777;
	WHILE ID DO
		BEGIN
		IF (PFPRO[ID] LSH -24)=PROT THEN RETURN(ID);
		ID←PFPRO[ID] LAND '7777
		END;
	RETURN(0)
	END "FPROPT";


_ Returns 0 iff FEAT1=FEAT2, 1 iff FEAT1<FEAT2, 2 iff FEAT1>FEAT2.
  Comparisons are made through appropriate masks.;

INTERNAL SIMPLE INTEGER PROCEDURE LESSFT(INTEGER FEAT1,FEAT2);
	BEGIN "LESSFT"
	LABEL CF,OU;
	INTEGER MASK1,MASK2;
	IF FEAT1<0 THEN IF FEAT2>0 THEN RETURN(2) ELSE GO CF
	   ELSE IF FEAT2<0 THEN RETURN(1);

	_ Compare line-features;

	MASK1←MASKLF(FEAT1);
	MASK2←MASKLF(FEAT2);
	GO OU;

	_ Compare compound features;

CF:	MASK1←MASKCF(FEAT1);
	MASK2←MASKCF(FEAT2);
OU:	RETURN(IF MASK1<MASK2 THEN 1 ELSE IF MASK1>MASK2 THEN 2 ELSE 0)
	END "LESSFT";
_ LNFEAT;
_ Returns line-feature descriptor word for line IL,
 traversed in the positive direction.;

INTERNAL SIMPLE INTEGER PROCEDURE LNFEAT(INTEGER IL);
	BEGIN "LNFEAT" 	LABEL BA1,BA2,BA0;
	INTEGER ISV1,BIS,POS,ISV2,BIT0,BIT1,BANG,IA,FRST,ISV3,
		SV11,SV12,SV21,SV22;
	REAL ANG,ANG0,ANG1,ANGCO,ANGS,AS11,AS12,AS21,AS22;
	ANGCO←180.;
BA0:	BIS←0;
	ISV2←ISV1←2*IL-1;
	POS←34;
BA2:	ANG←-1000.;
	FRST←BIT0←BIT1←0;
BA1:	ISV3←ISV2;
	ISV2←ABS NEXTSV(-ISV2,1);
	ANG0←ANG;
	ANG←ANGSV(ISV1,ISV2);
	IF ¬FRST THEN
		BEGIN
		IF POS≥30 THEN
			BEGIN
			AS12←ANG;
			SV12←ISV2;
			END ELSE BEGIN
			AS11←ANG;
			SV11←ISV2;
			END;
		FRST←4
		END;
	IF ANG<ANGCO THEN BIT0←BIT0+1 ELSE
		BEGIN
		IF FRST=4 THEN
			BEGIN
			FRST←9;
			BANG←IF(ANGS←ANG1←ANG-ANG0)<
			       (IF DEGSW THEN 174. ELSE 180.) THEN 0 ELSE 2;
			IF ABS(180.-(IF ANG0=-1000. THEN ANG ELSE ANG1))≤6.1
				THEN BANG←BANG+1;
			BIS←BIS LOR (BANG LSH (POS-11))
			END;
		IF ISV1≠ISV2 THEN BIT1←BIT1+1;
		END;
	IF ABS(180.-ANG)≤RMAP THEN BIS←BIS LOR (1 LSH (POS-FRST));
	IF ISV1≠ISV2 THEN GO BA1;
	IF DEGSW=2∧BIT0+BIT1=2∧BANG LAND 2∧ANGS<180.∧ANGCO=180. THEN
		BEGIN
		ANGCO←174.;
		GO BA0
		END;
	IF POS≥30 THEN
		BEGIN
		AS22←ANG0-180.;
		SV22←ISV3;
		END ELSE BEGIN
		AS21←ANG0-180.;
		SV21←ISV3;
		END;
	BIS←BIS LOR (BIT0 LSH (POS-3)) LOR (BIT1 LSH (POS-8));
	IF POS=34 THEN
		SV22←ISV3;
	BIS←BIS LOR (BIT0 LSH (POS-3)) LOR (BIT1 LSH (POS-8));
	IF POS=34 THEN
		BEGIN
		POS←16;
		ISV2←ISV1←ISV1+1;
		GO BA2
		END;
	BANG←IF(ANG1←AS11-AS22)<0.∧ANG1>-180. THEN 0 ELSE 2;
	IF ABS ANG1≤RMAP∧LVERCO[LVOPP(SV11)]≠LVERCO[LVOPP(SV22)]
		THEN BANG←BANG+1;
	BIS←BIS LOR (BANG LSH 21);
	BANG←IF(ANG1←AS12-AS21)<0.∧ANG1>-180. THEN 0 ELSE 2;
	IF ABS ANG1≤RMAP∧LVERCO[LVOPP(SV12)]≠LVERCO[LVOPP(SV21)]
		THEN BANG←BANG+1;
	BIS←BIS LOR (BANG LSH 3);
	IF (FTREV←LESSFT(BITS(BIS,0,17),BITS(BIS,18,35)))=1
		THEN BIS←BIS ROT 18;
	RETURN(BIS)
	END "LNFEAT";
_ COFEAT;

_ Returns compound feature word for lines L1 and L2 iff they share a c.v.
  (else 0). LF1 and LF2  refer to entries in the feature table (from LFEAT).
  They are negated iff l.f. is ordered contrary to the line.;

INTERNAL SIMPLE INTEGER PROCEDURE COFEAT(INTEGER L1,L2,LF1,LF2);
	BEGIN "COFEAT"
	LABEL BA1;
	INTEGER ICV,BIS,ISV3,ISV4,KAR,ISIDE,LSV1,LSV2,LSV3,LSV4;
	EXTERNAL INTEGER IP1, IP2;
	REAL ANG;
	IF ¬(ICV←SHARCV(L1,L2))∨L1=L2∨¬LF1∨¬LF2 THEN RETURN(0);
	BIS←     '400000400000
	     LOR ((LF1 LAND '7777) LSH 27)
	     LOR ((LF2 LAND '7777) LSH 9)
	     LOR (((ISV1←ICV LSH -2) XOR 
		(IF LF1 LAND '100000000000 THEN 0 ELSE 1)) LSH 26)
	     LOR (((ISV2←(ICV LSH -1) LAND 1) XOR
		   (IF LF2 LAND '100000000000 THEN 0 ELSE 1)) LSH 8)
	     LOR (SVDIST(ISV3←2*L1-1+ISV1,ISV4←2*L2-1+ISV2) LSH 22)
	     LOR (SVDIST(ISV4,ISV3) LSH 4);

_	 Now find line-constellation codes for far ends;

	ISV3←2*L1-ISV1;
	ISV4←2*L2-ISV2;
	ISIDE←18;
BA1:	LSV3←LVOPP(LSV1←LVERPT(ISV3));
	LSV4←LVOPP(LSV2←NEXTSV(ISV4,1));
	ANG←ANGSV(ISV3,ISV4)+ANGSV(LSV1,ISV3)+ANGSV(ISV4,LSV2)-360.;
	KAR←KARN(XLCOR[LSV3],YLCOR[LSV3],XLCOR[LSV1],YLCOR[LSV1],
		 XLCOR[LSV4],YLCOR[LSV4],XLCOR[LSV2],YLCOR[LSV2],0);
	IF ANG<-180.∨ANG>180. THEN BIS←BIS LOR (1 LSH (ISIDE+3));
	IF ABS ANG ≤RMAP ∨ ABS(ANG-360.)≤RMAP THEN BIS←BIS LOR (1 LSH ISIDE);
	IF KAR=-1∧ABS(ANG+180.)<45. THEN BIS←BIS LOR (1 LSH (ISIDE+1));
	IF IP1=2∨IP2=2 THEN BIS←BIS LOR (1 LSH (ISIDE+2));
	IF ISIDE THEN BEGIN ISIDE←0; ISV3↔ISV4; GO BA1 END;
	IF (FTREV←LESSFT(BITS(BIS,0,17),BITS(BIS,18,35)))=1
		THEN BIS←BIS ROT 18;
	RETURN(BIS)
	END "COFEAT";
_ FINDFT, MAXLCR;

_ Finds entry of FEAT, if any, in the central tables. Binary search.
  Automatically distinguishes between l.f. and c.f.;

INTERNAL SIMPLE INTEGER PROCEDURE FINDFT(INTEGER FEAT);
	BEGIN "FINDFT"
	INTEGER CD,CU,CI;
	IF ¬FEAT THEN RETURN(0);
	IF FEAT<0 THEN BEGIN CI←CD←PLFTOT+1; CU←PFTOT END
		  ELSE BEGIN CI←CD←1; CU←PLFTOT END;
	WHILE CU≥CD DO
		BEGIN
		CI←CD+(CU-CD+1)%2;
		CASE LESSFT(FEAT,PFLST[CI]) OF
			BEGIN
			"="  RETURN(CI);
			"<"  CU←CI-1;
			">"  CI←CD←CI+1
		        END
		END;
	RETURN(-CI)
END "FINDFT";


_	Returns the maximal (but <1000) currently used LCREDE in stack
	of any line.;

SIMPLE INTEGER PROCEDURE MAXLCR;
	BEGIN "MAXLCR" INTEGER IA,IB,IC,ID,IE;
	IB←-1000000;
	LOOP(IA,1,MAXNOL,1) IF (IE←LCREDE[IA])≥0 THEN
	    LOOP(IC,0,24,12) IF IB<(ID←BITS(IE,IC,IC+11))∧ID<1000 THEN IB←ID;
	RETURN(IB)
	END "MAXLCR";
_ FTEX;
_ Extracts l.f:s and c.f:s over the active scene, storing l.f:s in LFEAT,
  and storing recognizable c.f:s in CFEAT;

INTERNAL SIMPLE PROCEDURE FTEX;
	BEGIN "FTEX" LABEL BA;
	INTEGER IA,IB,COFAD,IC,ID,IFT,LF,LFB;
	DEFINE LACT(I)="(LNCRE1≤LCREDE[I] LAND '400000007777≤LNCRE2)";
	SCF←0;
	DEGSW←IF DEGABL THEN 1 ELSE 0;
	LOOP(IA,PLFTOT+1,PFTOT,1)
		PFPTR[IA]←PFPTR[IA] LAND '777700007777;
	LOOP(IA,1,MAXNOL,1) IF LACT(IA) THEN
		BEGIN
		LF←LFEAT[IA]←(FINDFT(LNFEAT(IA)) MAX 0);
		IF LF∧FTREV=1 THEN LFEAT[IA]←LF LOR '100000000000;
		END;
	LOOP(IA,1,MAXNOL-1,1) IF LACT(IA)∧(LF←LFEAT[IA]) THEN
		LOOP(IB,IA+1,MAXNOL,1) IF LACT(IB)∧(LFB←LFEAT[IB])∧
		 (COFAD←FINDFT(COFEAT(IA,IB,LF,LFB)))>0 THEN
			BEGIN
			CFEAT[SCF←SCF+1]←BITS(PFPTR[COFAD],12,23)
 			    LOR (ISV1 LSH 11 + IA)
				LSH (24-12*(FTREV LAND 1))
			    LOR (ISV2 LSH 11 + IB)
				LSH (12+12*(FTREV LAND 1));
			PFPTR[COFAD]←(PFPTR[COFAD] LAND '777700007777)
				LOR (SCF LSH 12)
			END;
	IF ¬PFTKEY THEN RETURN;

	_ Now extract partially similar features in the scene.;

	LOOP(IA,1,MAXNOL,1) IF LACT(IA)∧¬LFEAT[IA] THEN
		BEGIN
		IFT←LNFEAT(IA);
		LOOP(IB,PLFTOT,1,-1) LOOP(IC,0,1,1) LOOP(ID,0,1,1)
			BEGIN
			LFDIF(PFLST[IB],IFT,IC,ID);
			IF ¬MODIF LAND '600000000000∧
			   ¬(MODIF LAND '52777777777∧
			     MODIF LAND '125377777777) THEN
				BEGIN
				LFEAT[IA]←IB LOR
				     ((IFT←(-(FTREV=1)) XOR IC XOR ID) LOR
				     (2 LOR (1-ID XOR IFT)) LSH 1) LSH 33;
				GO BA
			        END
		        END;
BA: 		END
	END "FTEX";
_ INSFT;

_ Inserts the feature FEAT into ordered storage, making sure there is a
  pointer back to prototype PROT. Feature id ≡ address in this storage.
  Returns address if successful (or feature already stored).
  L2 contains l.f. equivalence class iff we are dealing with an l.f.
  No-action returns: 0 if no free storage, -1 if FEAT=0;
_ NEEDS WORK ON EXPANSION CASES;

INTERNAL SIMPLE INTEGER PROCEDURE INSFT(INTEGER FEAT,PROT,L1,L2);
	BEGIN "INSFT"
	LABEL ON1;
	INTEGER AD,IA,TYP,IB,FPPTR,FPP,FPS,NRAY,PL1,PL2,EQ1,EQ2,EQ3,EQ4;
	IF ¬FEAT THEN RETURN(-1);
	IF L2∧FEAT>0 THEN BEGIN AD←FEAT; GO ON1 END;
	IF (AD←FINDFT(FEAT))<0 THEN
		BEGIN
		AD←-AD;
		IF PFTOT=MAXPFT THEN RETURN(0);
		LOOP(IA,PFTOT,AD,-1)
			BEGIN
			PFLST[IA+1]←PFLST[IA];
			PFPTR[IA+1]←PFPTR[IA]
		        END;
		PFLST[AD]←FEAT;
		PFTOT←PFTOT+1;
		IF FEAT>0 THEN
			BEGIN
			LOOP(IA,1,MAXNOL,1) IF ABS (IB←LFEAT[IA])≥AD
				    THEN LFEAT[IA]←ISIGN(ABS IB + 1,IB);
			PLFTOT←PLFTOT+1;
			LOOP(IA,1,MAXPLT,1)
				IF(IB←PLINE2[IA])≥AD THEN PLINE2[IA]←IB+1;
			LOOP(IA,PLFTOT+1,PFTOT,1) LOOP(IB,9,27,18)
				IF(TYP←BITS(PFLST[IA],IB,IB+7))≥AD THEN
					PFLST[IA]← (PFLST[IA] LAND
					   (IF IB=9 THEN '777777400777
					        ELSE '400777777777))
					        LOR ((TYP+1) LSH IB)
		        END ELSE PCFTOT←PCFTOT+1;
		LOOP(IA,1,PFREE-1,1)
			IF(IB←PFEAT[IA])<0∧(TYP←BITS(IB,12,23))≥AD THEN
				PFEAT[IA]←(IB LAND '777700007777) LOR
				   ((TYP+1) LSH 12);
		NRAY←NLINCV(LVERCO[2*L1-1])+NLINCV(LVERCO[2*L1])-2;
		IF FEAT<0 THEN NRAY←NRAY+NLINCV(LVERCO[2*L2-
			((SHARCV(L1,L2) LSH -1) LAND 1)])-2;
		PFPTR[AD]←(NRAY LSH 30) LOR (IF FTREV THEN 0
			ELSE '4000000000)
		END;
	IF ¬L2 THEN RETURN(AD);
ON1:	EQ1←BITS(PLINE[PLTOT+(PL1←LEDG1[L1])],5,9);
	PL2←LEDG1[L2];
	IF FEAT<0 THEN EQ2←BITS(PLINE[PLTOT+PL2],5,9);
	IF ¬(FPPTR←FPROPT(AD,PROT)) THEN
		BEGIN
		IF PFFREE>MAXPFT THEN RETURN(0);
		PFPRO[PFFREE]←(PROT LSH 24) LOR (PFPTR[AD] LAND '7777);
		PFPTR[AD]←(PFPTR[AD] LAND '777777770000) LOR PFFREE;
		PFPRO[PFFREE]←PFPRO[PFFREE] LOR (PFREE LSH 12);
		PFEAT[FPS←PFREE]←'400000000000 LOR (PROT LSH 24)
			LOR (AD LSH 12);
		PFREE←PFREE+1;
		PFFREE←PFFREE+1
		END ELSE BEGIN
		FPPTR←FPP←(FPS←BITS(PFPRO[FPPTR],12,23))+1;
		WHILE (IB←PFEAT[FPP])
			∧(FEAT>0∧EQ1≠BITS(IB,12,21)∨FEAT<0∧
			(EQ1≠(EQ3←BITS(PLINE[PLTOT+BITS(IB,24,33)],5,9))∨
			EQ2≠(EQ4←BITS(PLINE[PLTOT+BITS(IB,12,21)],5,9)))∧
			(FTREV∨EQ1≠EQ4∨EQ2≠EQ3))
			∧(FPP←PFEAT[FPP] LAND '7777) DO FPPTR←FPP;

		_ We make sure here that each prototype and equivalence-
		class combination only occurs once for each feature 
		(l.f. or c.f.).;

		IF FPP THEN RETURN(AD);
		PFEAT[FPPTR]←PFEAT[FPPTR] LOR PFREE
		END;
	PFEAT[PFREE]←(PL1 LSH 24) LOR
	     (IF FEAT>0 THEN EQ1 ELSE PL2 LOR '4000 LOR
		(((FEAT LSH -4 LAND '20000000) LOR
		  (FEAT LSH  2 LAND '2000)) XOR '20002000)) LSH 12;
	PFREE←PFREE+1;
	PFEAT[FPS]←PFEAT[FPS]+1;
	RETURN(AD)
	END "INSFT";
_ PLEQV;

_ Finds and stores line-feature equivalence classes for prototype IP.
  Also finds parallelity classes (and stores in PLINE).
  NOTE that this particular implementation of the algorithm allows for
  at most 31 equivalence classes and at most 8 lines per vertex.;

INTERNAL PROCEDURE PLEQV(INTEGER IP);
	BEGIN "PLEQV"
	LABEL BA0;
	REAL RL;
	INTEGER IA,IB,IC,ID,IE,IAA,IEC,IEQ,IEQV,LN,IVB,TYP,ILOOP,FTDIR;
	SAFEX INTEGER ARRAY EQUIVS,EQUIVT,LFTYPS[1:PLINES[IP]],VB,VC[0:1];
	IC←PLINES[IP]+(IB←PPTRL[IP])-1;
	IEQ←IAA←0;

	_ This first loop provides an initial assignment of tentative
	  equivalence classes, one for each line-feature type;
	_ For each line of the prototype ......;

	LOOP(IA,IB,IC,1)
		BEGIN
		LFTYPS[IAA←IAA+1]←TYP←FINDFT(PLINEF[IA] LAND '377777777777);
		IEQV←0;

		_ ...... check if we have seen this type before;

		LOOP(ID,1,IAA-1,1) IF TYP= LFTYPS[ID] THEN
			BEGIN
			IEQV←EQUIVS[ID];
			DONE
			END;
		EQUIVT[IAA]←EQUIVS[IAA]←(IF ¬IEQV THEN (IEQ←IEQ+1) ELSE IEQV)
		END;

	_ The initial assignment now exists.;

	IEQV←IEQ;
_ PLEQV cont;

	_ The following iterated structure of 3 loops and one pointer search
	  performs the main step of the algorithm;

	_ For each tentative equivalence class ......;

BA0:	ILOOP←0;	_ Keeps track of change-occurrences;
	LOOP(IA,1,IEQV,1)
		BEGIN "LP1"
		IAA←IEC←0;  _ IAA keeps track of the basic line of the class.
				  IEC keeps track of the first change;
		VB[0]←VB[1]←0;	_ VB stores l.f.-constellations at ends of
					base line;

		_ ...... and every line that belongs to it ......;

		LOOP(ID,1,PLINES[IP],1) IF EQUIVS[ID]=IA THEN
			BEGIN "LP2"
			VC[0]←VC[1]←0;  _ VC stores l.f.-constellations at
					ends of new line;
			FTDIR←(PLINEF[ID+IB-1]≥0); _ FTDIR is on iff l.f.
							is directional.;

			_ ...... and for each end of such a line ......;

			LOOP(IE,0,1,1)
				BEGIN "LP3"  LABEL BA3,ON3;
				LN←ID;
				IEQ←6*IE;
				IVB←BITS(PLINE[IB+LN-1],24+IEQ,29+IEQ);

				_ IVB is the base-line c.v.;
				_ ...... and every other line that goes
				         to that vertex ......;

BA3:				LN←BITS(PLINE[IB+LN-1],12+IEQ,17+IEQ);

				_ LN is the new line;
				_ Check if we are back to the current line,
				  i.e. if the c.v. is exhausted;

				IF LN=ID THEN GO ON3;
_ PLEQV cont;
				_ If we are dealing with the first line of
				  a class, its classification is accepted,
				  and we pack the information for the other
				  lines of its vertices
				  into VB. Otherwise the information is packed
				  into VC, for later comparison with VB;

				IF ¬IAA THEN VB[IE]←(VB[IE] LSH 5)
						LOR EQUIVS[LN]
					ELSE VC[IE]←(VC[IE] LSH 5)
						LOR EQUIVS[LN];

				_ Now find correct end of the other line,
				  to find pointer to next line;

				IEQ←(IF IVB=BITS(PLINE[IB+LN-1],30,35)
					THEN 6 ELSE 0);
				GO BA3;
ON3:						_ This vertex is exhausted;
			        END "LP3";

			_ This line is now classified in terms of its branches.
			  Compare it with the basic line, if this isn't it.
			  NOTE that the equivalence classification
			  is directional according to the l.f:s.;

			IF IAA THEN IF (VB[0]≠VC[0]∨VB[1]≠VC[1])∧
				       (FTDIR∨VB[0]≠VC[1]∨VB[1]≠VC[0]) THEN
				BEGIN

				_ The line does not belong to the same
				  equivalence  class as the basic line.
				  Create a new class, if this line is the
				  first one to not conform,
				  else use the previously created class;

				IF ¬IEC THEN
					BEGIN
					IEC←1;
					IEQV←IEQV+1;
					ILOOP←1
					END;
				EQUIVT[ID]←IEQV
				END;
			IAA←1
			END "LP2";
		ARRTRAN(EQUIVS,EQUIVT)
		END "LP1";
	IF ILOOP THEN GO BA0;
_ PLEQV cont;

_	 THE CLASSIFICATIONS ARE NOW CONSISTENT WITH THE RECURSIVE DEFINITION.
		STORE THE EQUIVALENCE CLASSES!;

	IE←0;
	LOOP(IA,IB,IC,1) PLINE[IA]←PLINE[IA] LOR (EQUIVS[IE←IE+1] LSH 5);

	_ Finally find length- and parallelity-classes.;

	IEQV←0;
	LOOP(IA,1,MAXNOL,1)
	   IF LACT(IA)∧¬(PLINE[ID←LEDG1[IA]+IB-1] LAND '37) THEN
		BEGIN
		IEQ←0;
		RL←RLEN[IA];
		LOOP(IE,IA+1,MAXNOL,1)
		   IF LACT(IE)∧¬(PLINE[LN←LEDG1[IE]+IB-1] LAND '37)∧
		     ANGLIN(IA,IE)<10. THEN
			BEGIN
			PLINE[LN]←PLINE[LN] LOR IEQV+(IEQ←1);
			RL←RL MIN RLEN[IE];
			END;
		IF IEQ THEN
			BEGIN
			PLINE[ID]←PLINE[ID] LOR (IEQV←IEQV+1);
			LOOP(IE,1,MAXNOL,1)
			    IF LACT(IE)∧PLINE[ID←LEDG1[IE]+IB-1]
				LAND '37=IEQV∧RLEN[IE]/RL>1.25
				    THEN PLINE2[ID]←PLINE2[ID] LOR '1000
			END
		END
	END "PLEQV";
_ CREPRO;

_ Creates a prototype structure from a line-drawing
  (using the line-editor for the drawing part, iff EDLIN≠0).;

INTERNAL PROCEDURE CREPRO;
	BEGIN "CREPRO"
	LABEL ON1,ON2,ON3,ON4;
	SAFEX INTEGER ARRAY LPATH[1:MAXNOV];
	INTEGER IL,IB,IV,IA,IC,ICV,ISV,LDS,LC1S,LC2S,ICX,IB2;
	REAL RMAPS;
	IF WHERE=16 THEN BEGIN WHERE←5; GO ON1 END;_ If we're expanding;
	IF WHERE=18 THEN GO ON2;
	IF WHERE=19 THEN GO ON3;
	TELL("prototype creation");
	IF NPRO≥MXNPRO THEN BEGIN MXNPRO←NPRO+3; WHERE←18; RETURN END;
	OUTSTR(CL&"NOTE, creation only.      Name of prototype:"&CL);
	PNAME[NPRO←NPRO+1]←QREAD;
	IF ¬EDLIN THEN GO ON4;
ON2:	LDS←LDATE;
	LC1S←LNCRE1;
	LC2S←LNCRE2;
	LNCRE1←LNCRE2←LDATE←(MAXLCR+1) MAX 1;
	WHERE←1;
	OUTSTR(CL&"OK, draw a """&PNAME[NPRO]&""""&CL&
	       "(when arrow appears, you are in the line-editor)"&CL);
ON1:	LINED;
	IF WHERE≠1 THEN BEGIN WHERE←16; RETURN END;

	_ Possible line-space expansion;

	_ Make sure prototype line-space is large enough;

ON4:	IF (IA←PLTOT+NOL-NOLS)>MAXPLT THEN
		BEGIN
		MXNPRO←IA%8+3;
		WHERE←19;
		RETURN
		END;

	_ Now X-ref analyze the drawing to make sure all c.v:s are OK;

ON3:	XREFC(0);
	WHERE←1;

	_ OK, now create the prototype cross-reference and pointer tables;

	PPTRL[NPRO]←PLTOT+1;
	PREXT←".TEM";
_ CREPRO cont;
	_ First assign a new, minimum numbering to the lines, in LEDG1,
	  and store line-features;

	IL←0;
	RMAPS←RMAP;
	RMAP←5.;
	LOOP(IB,1,MAXNOL,1) IF LACT(IB) THEN
		BEGIN
		LEDG1[IB]←(IL←IL+1);
		PLINE2[IC←PLTOT+IL]←LFEAT[IB]←
			INSFT(PLINEF[IC]←LNFEAT(IB),NPRO,IB,0);
		IF ¬FTREV THEN PLINEF[IC]←PLINEF[IC] LOR '400000000000;
		IF FTREV=1 THEN LFEAT[IB]←-LFEAT[IB]
		END;
	RMAP←RMAPS;
	LOOP(IB,PLTOT+1,PLTOT+IL,1) PLINE[IB]←0;
	MAXPLS←(PLINES[NPRO]←IL) MAX MAXPLS;

	_ The following loop numbers the vertices (in LPATH) as they are
	  referenced, stores X-ref and pointer information, etc. Also
	  stores compound features.;

	IA←PLTOT;
	IV←0;

	_ Zero LPATH-entries for vertices belonging to current prototype.;

	LOOP(IB,1,MAXNOV,1) IF BELCRE(IB) THEN LPATH[IB]←0;
	LOOP(IB,1,MAXNOL,1) IF LACT(IB) THEN
		BEGIN
		LOOP(IC,1,0,-1)
			BEGIN
			ICX←ABS(IC+(LFEAT[IB]<0));
			ICV←LVERCO[ISV←2*IB-IC];
			IF ¬LPATH[ICV] THEN LPATH[ICV]←(IV←IV+1);
			PLINE[IA←IA+IC]←PLINE[IA] LOR
			       (LPATH[ICV] LSH (24+ICX*6)) LOR
			       (LEDG1[(ABS LVER[ISV]+1)%2] LSH (12+ICX*6));
			IF SVANG[ISV]≥180. THEN
				PLINE[IA]←PLINE[IA] LOR (1 LSH (11-ICX));

			_ (If this SVANG ≥180., the other side of the line
			   must be the outside);
			_ Note that PLINE is reordered iff l.f. was reversed.;

			END
		END;
	MAXPVS←(PVERTS[NPRO]←IV) MAX MAXPVS;
_ CREPRO cont;
	_ Find and store prototype line equivalence-, length-, and
		parallelity-classes.;

	PLEQV(NPRO);

	_ Now make sure PFEAT contains one reference for each combination
	  of prototype and l.f.-equivalence class.;

	LOOP(IB,1,MAXNOL,1) IF LACT(IB) THEN
		BEGIN
		INSFT(ABS LFEAT[IB],NPRO,IB,IB);
		LOOP(IB2,IB+1,MAXNOL,1) IF IB≠IB2∧LACT(IB2) THEN
			INSFT(COFEAT(IB,IB2,LFEAT[IB],LFEAT[IB2]),
			NPRO,IF(IC←FTREV≠1) THEN IB ELSE IB2,
			IF IC THEN IB2 ELSE IB)
		END;
	PLTOT←PLTOT+IL;

	_ This completes the prototype.
	  Finally erase (?) the line-drawing of the prototype,
	  and restore the date-values to their original amounts;

	IF ¬EDLIN THEN BEGIN UNTELL; RETURN END;
	LINCHA(0,LDATE,0);
	LDATE←LDS;
	LNCRE1←LC1S;
	LNCRE2←LC2S;	
	DICH[4]←DICH[5]←DICH[6];
	DFORCE←1;
	UPPDAT;
	DFORCE←0;
	UNTELL
	END "CREPRO";

END "PROT";